Project 3: Advanced Cartography
logo



For this report, I used the epuRate’s template of Yan Holtz who made it publicly available.

Introduction

The IHME Development Assistance for Health Database lists grants and loans provided to developing countries by other countries to combat diseases such as HIV, Malaria and other health problems. The file contains data from 1990 to 2019.

In this project, I will use my skills on cartography using cloropleth maps, cartograms and map animation.

Question 1

The goal of the first question is to show the variation of dollars spent by country in 2019. We see that there are great disparities between countries. The United States, Germany and England are the three countries that have given the most money. They gave at least 6 times more money than Spain for example. We also see that the number of countries giving money is not very large. Obviously, countries with large GDP have more means to give money than small countries. It would be interesting to have the percentage of expenditure that this represents for each country.

# Import Data
ihme <- read_csv("data/IHME_DAH_DATABASE_1990_2019_Y2020M04D23.CSV", na = c(NA,"-",""))

# Prepare data for total expenditure in 2019
tot_spending_2019 <- ihme %>% 
  filter(year == 2019) %>% 
  select(source, dah_19) %>% 
  group_by(source) %>% 
  summarise(expenditure = sum(dah_19)) %>% 
  ungroup()

# add the 3-letter code for each country
tot_spending_2019 <- tot_spending_2019 %>% 
  mutate(source_code = countrycode::countrycode(sourcevar = source,
                                         origin = "country.name",
                                         destination = "iso3c"))

# Import shapefiles (X)
world <- st_read("data/naturalearth/ne_110m_admin_0_countries.shp")

# Joining the files
world_2019 <- world %>%
  left_join(tot_spending_2019, c("ISO_A3" = "source_code"))

# Create categories function
quantiles <- function(data) {
  data %>% 
    pull(expenditure) %>% 
    quantile(probs = c(0, 0.25, 0.5, 0.75, 1), na.rm = TRUE)
}

# Categories
quantile_spending_2019 <- quantiles(world_2019)

# Reformating the labels function
labels <- function(quantiles) {
  tibble(
  lab1 = quantiles,
  lab2 = c(quantiles[2:length(quantiles)], NA)) %>%
  slice(1:n() - 1) %>% # We remove the last row, since it has no meaning
  mutate_all(round, digits = 0) %>% # We remove digits after the 0
  mutate_all(format, big.mark = "'") %>% 
  mutate_all(paste0, "$") %>% # We add the dollar sign after the digits
  mutate(labs = paste(lab1, lab2, sep =  "-"))
}

# Labels
labels_spending <- labels(quantile_spending_2019)

# Includes categories in the shapefile with correct labels function
to_category <- function(data, quantiles, labels) {
  data %>%
  mutate(quantiles = cut(expenditure,
                         breaks = quantiles, 
                         labels = labels$labs, 
                         include.lowest = TRUE))
}

world_2019 <- to_category(world_2019, quantile_spending_2019, labels_spending)

# Change the projection
world_robin_2019 <- st_transform(world_2019, crs = 'ESRI:54030')

# Plot the map
ggplot(data = world_robin_2019)+
  geom_sf(mapping = aes(fill = quantiles)) +
  scale_fill_carto_d(type = quantitative, palette = "BurgYl") +
  guides(fill = guide_legend(label.position = "bottom")) +
  theme_void() +
  theme(legend.position = "bottom") +
  labs(
    title = "Total expenditures per country for health aid",
    subtitle = "in 2019",
    caption = "Source: Eurostat",
    fill = "" )

And what about the other side, i.e. the receivers? Who do you think got the most aids? Unfortunately, we don’t have the data for 2019. So we have to go back a little bit. Let’s look at what happened in 2015.

Question 2

# Prepare data for total expenditure in 2015
tot_earnings_2015 <- ihme %>% 
  filter(year == 2015) %>% 
  select(recipient_isocode, dah_19) %>% 
  group_by(recipient_isocode) %>% 
  summarise(expenditure = sum(dah_19), na.rm = TRUE) %>% 
  ungroup()

# Joining the files
world_2015 <- world %>%
  left_join(tot_earnings_2015, c("ISO_A3" = "recipient_isocode"))

# Create categories
quantile_earnings <- quantiles(world_2015)

# Reformating the labels
labels_earnings <- labels(quantile_earnings)

# Includes categories in the shapefile with correct labels
world_2015 <- to_category(world_2015, quantile_earnings, labels_earnings)

# Change the projection
world_robin_2015 <- st_transform(world_2015, crs = 'ESRI:54030')

# Plot the map
ggplot(data = world_robin_2015)+
  geom_sf(mapping = aes(fill = quantiles)) +
  scale_fill_carto_d(type = quantitative, palette = "BurgYl") +
  guides(fill = guide_legend(label.position = "bottom")) +
  theme_void() +
  theme(legend.position = "bottom") +
  labs(
    title = "Total funds received per country for health aid",
    subtitle = "in 2015",
    caption = "Source: Eurostat",
    fill = ""  )

Only 3 countries received financial support in 2015. The largest grant was to the Democratic Republic of Congo. I know that 2015 was exactly in the middle of the Ebola virus. However, the data does not seem to show this kind of disease. Although the data would allow us to analyse this in more depth, let’s try to get a more global view.

Question 3

We would indeed like to have an overview of financial aid by major regions, rather than by country. To do this, we need to redefine the shape of our map. Fortunately, there is a function to merge the different countries.

# Extract the name of the gdb_regions
gbd_region_name <- ihme %>% 
  distinct(gbd_region) %>% 
  filter(gbd_region != "Europe, Western",
         gbd_region != "Global",
         gbd_region != "Unallocated/Unspecified")

# create lists of all country codes within a region
region <- ihme %>% 
  group_by(gbd_region) %>% 
  distinct(recipient_isocode) %>%
  summarise(recipient_isocode = list(recipient_isocode)) %>% 
  filter(gbd_region != "Europe, Western",
                                           gbd_region != "Global",
                                           gbd_region != "Unallocated/Unspecified")

# Create an empty list
gbd_region_sf <- list()

# for each region, Populate the empty list with all rows from "world" which corresponds to the country of the region
for (i in 1:nrow(region)) {
  gbd_region_sf[[i]] <- world %>% 
    filter(ISO_A3 %in% as_vector(region[[2]][i]))
}

# Populate the gbd_region_sf with one last region, those who never received aid or are not part of the subregion from above.
other_region <- ihme %>% 
  group_by(gbd_region) %>% 
  distinct(recipient_isocode)

gbd_region_sf[[19]] <- world %>% 
  filter(!(ISO_A3 %in% other_region$recipient_isocode))

# Give the names of the region to the new lists
names(gbd_region_sf) <- gbd_region_name$gbd_region
names(gbd_region_sf)[[19]] <- "other_country"

# Extract the lists in order to have  a data frame for each region in the global environment
list2env(gbd_region_sf, .GlobalEnv)

# clipping all the regions to have a single geometry
asia_pacific <- st_union(`Asia Pacific, high-income`)
asia_central <- st_union(`Asia, Central`)
asia_south <- st_union(`Asia, South`)
asia_east <- st_union(`Asia, East`)
asia_southeast <- st_union(`Asia, Southeast`)
latin_america_andean <- st_union(`Latin America, Andean`)
latin_america_central <- st_union(`Latin America, Central`)
latin_america_south <- st_union(`Latin America, Southern`)
latin_america_tropical <- st_union(`Latin America, Tropical`)
north_africa_middle_east <- st_union(`North Africa/Middle East`)
oceania <- st_union(Oceania)
sub_saharan_africa_central <- st_union(`Sub-Saharan Africa, Central`)
sub_saharan_africa_south <- st_union(`Sub-Saharan Africa, Southern`)
sub_saharan_africa_east <- st_union(`Sub-Saharan Africa, Eastern`)
sub_saharan_africa_west <- st_union(`Sub-Saharan Africa, Western`)
europe_central <- st_union(`Europe, Central`)
europe_east <- st_union(`Europe, Eastern`)
caribbean <- st_union(Caribbean)
other_country <- st_union(other_country)


# Create a new empty shapefile
nrows <- 19
geometry = st_sfc(lapply(1:nrows, function(x) st_geometrycollection()))
df <- st_sf(id = 1:nrows, geometry = geometry)

# Populate the new shapefile
df$geometry <- c(asia_pacific, asia_south,  asia_central, asia_east, asia_southeast ,latin_america_andean , latin_america_central, latin_america_south , latin_america_tropical, north_africa_middle_east, oceania , sub_saharan_africa_central, sub_saharan_africa_south, sub_saharan_africa_east, sub_saharan_africa_west, europe_central, europe_east, caribbean, other_country)

# Select the total of money spent
tot_earnings <- ihme %>% 
  group_by(gbd_region) %>% 
  summarise(expenditure = sum(dah_19, na.rm = TRUE)) %>% 
  filter(gbd_region != "Europe, Western",
         gbd_region != "Global",
         gbd_region != "Unallocated/Unspecified") %>% 
  rbind(c("other_country", NA)) %>% 
  mutate(expenditure = as.numeric(expenditure))

df$expenditure <- tot_earnings$expenditure

# Create quantiles
quantile_tot <- quantiles(df)

# Reformating the labels
labels_earnings_tot <- labels(quantile_tot)

# Includes categories in the shapefile with correct labels
df <- to_category(df, quantile_tot, labels_earnings_tot)

# Change the projection
world_robin_tot <- st_transform(df, crs = 'ESRI:54030')

# Plot the map
ggplot(data = world_robin_tot)+
  geom_sf(mapping = aes(fill = quantiles)) +
  scale_fill_carto_d(type = quantitative, palette = "BurgYl") +
  guides(fill = guide_legend(label.position = "bottom")) +
  theme_void() +
  theme(legend.position = "bottom") +
  labs(
    title = "Total funds received per country for health aid",
    subtitle = "from 1990 to 2019",
    caption = "Source: Eurostat",
    fill = ""
  )

In the period from 1990 to 2019, North Africa, South Africa and South Asia are the regions that have received the most financial support. In contrast, North America, Europe and Australia have not received any aid in the last 30 years.

Question 4

What if we want to see the changes over the years? Let’s try to create an animated map.

# Prepare data for total expenditure 
tot_earnings <- ihme %>% 
  select(recipient_isocode, dah_19, year) %>% 
  group_by(recipient_isocode, year) %>% 
  summarise(expenditure = sum(dah_19),) %>% 
  ungroup()

# Creating the world dataframes for each year
years <- c(1990:2019)
for (i in years) {
  assign(paste0("world", i), world %>% mutate( year = i))
}

#Binding dataframes together
world_year <- bind_rows(world1990,
                        world1991,
                        world1992,
                        world1993,
                        world1994,
                        world1995,
                        world1996,
                        world1997,
                        world1998,
                        world1999,
                        world2000,
                        world2001,
                        world2002,
                        world2003,
                        world2004,
                        world2005,
                        world2006,
                        world2007,
                        world2008,
                        world2009,
                        world2010,
                        world2011,
                        world2012,
                        world2013,
                        world2014,
                        world2015,
                        world2016,
                        world2017,
                        world2018,
                        world2019)
  
# Joining the files
world_year <- world_year %>%
  left_join(tot_earnings, c("ISO_A3" = "recipient_isocode", "year" = "year"))

# Create categories
quantile_earnings <- quantiles(world_year)

# Reformating the labels
labels_earnings <- labels(quantile_earnings)

# Includes categories in the shapefile with correct labels
world_year <- to_category(world_year, quantile_earnings, labels_earnings)

# Change the projection
world_eck_year <- st_transform(world_year, crs = 'ESRI:54013')

world_eck_year <- world_eck_year %>% 
  st_simplify()

# Plot the map
ggplot()+
  geom_sf(data = world_eck_year,
          mapping = aes(fill = quantiles)) +
  scale_fill_carto_d(type = quantitative, palette = "BurgYl") +
  guides(fill = guide_legend(label.position = "bottom")) +
  theme_void() +
  theme(legend.position = "bottom") +
  labs(
    title = "Total funds received per country for health aid",
    subtitle = "{closest_state}",
    caption = "Source: Eurostat",
    fill = ""  ) +
  transition_states(year, state_length = 10, transition_length = 10)

I am aware that there is a glitch in the visualization. Unfortunately, Despite some hours of research, I wasn’t able to find a solution. I also tried to book a 1-1 but he couldn’t help me either. If someone know the solution, I would be very happy to hear from him. Thanks in advance !

“Ok, it’s nice but it goes too fast! I would like to be able to spend more time on a specific year.” No problem, instead of having an animated map, we can also have an interactive map! I wonder who received the most HIV donations in 1993.

Question 5

Donations received for the fight against HIV by country in 1993"

# Select the spendings on HIV in 1993
ihme_hiv<- ihme %>%
  filter(year == 1993) %>% 
  select(
    recipient_isocode, 
    contains(c("hiv"))
  )

# Sum all the spending on HIV per country
ihme_hiv_long <- ihme_hiv %>%
  pivot_longer(cols = contains(c("hiv"))) %>%
  group_by(recipient_isocode) %>%
  summarise(earnings = sum(value)) %>%
  mutate(earnings = ifelse(earnings == 0, NA, earnings)) %>% 
  ungroup()

# join files
world_hiv <- world %>% 
  left_join(ihme_hiv_long, by = c("ISO_A3" = "recipient_isocode")) %>% 
  select(SOVEREIGNT, everything()) # in order to have the name of the country in the interactive map

# Change the projection
world_robin_hiv <- st_transform(world_hiv, crs = 'ESRI:54030')

# Creating an interactive Choropleth
tmap_mode("view") # make interactive

world_hiv_map <- tm_shape(world_robin_hiv) +
  tm_polygons(col = "earnings",
              style = "quantile",
              palette = "-viridis")

world_hiv_map



So, were you able to detect which country received the most money to fight HIV in 1993? That’s right ! It was India with 12516 Dollars.

Question 6

Lastly, I would like to zoom in on the African continent by adding an “inset map” next to it. To do this, I will first create the main map.

Create the main map

#Select the year and disease of interest
tot_earnings_1991 <- ihme %>% 
  filter(year == 1991) %>% 
  select(recipient_isocode, dah_19) %>% 
  group_by(recipient_isocode) %>% 
  summarise(expenditure = sum(dah_19)) %>% 
  ungroup()

#joining the files
world_1991 <- world %>% 
  left_join(tot_earnings_1991, by = c("ISO_A3" = "recipient_isocode"))

#Create categories
quantiles_1991 <- quantiles(world_1991)
labels_1991 <- labels(quantiles_1991)
world_1991 <- to_category(world_1991, quantiles_1991, labels_1991)

# Extract the african continent
africa <- world_1991 %>% 
  filter(CONTINENT == "Africa") %>% 
  st_transform(crs = 'ESRI:54030')

ggplot(data = africa)+
  geom_sf(mapping = aes(fill = quantiles)) +
  scale_fill_carto_d(type = quantitative, palette = "BurgYl") +
  guides(fill = guide_legend(label.position = "bottom")) +
  theme_void() +
  theme(legend.position = "bottom") +
  labs(
    title = "Total funds received per country for health aid in Africa",
    subtitle = "1991",
    caption = "Source: Eurostat",
    fill = ""
  )

Create the inset map

world_robinson <- st_transform(world, crs = "ESRI:54030")

# add a rectancle around africa
african_rectangle <- world %>% 
  filter(CONTINENT == "Africa") %>% 
  st_transform(crs = 'ESRI:54030') %>% 
  st_bbox() %>% 
  st_as_sfc() %>% 
  st_buffer(150000)

# Create the inset_map
africa_inset_map <- ggplot() + 
  geom_sf(data = world, 
          fill = "white",
          size = 0.3,
          colour = "lightgrey") + 
  geom_sf(data = african_rectangle, 
          fill = NA, 
          color = "red", 
          size = 0.8) +
  theme_void()

africa_inset_map

# Africa bb
africa_bb <- world%>% 
  filter(CONTINENT == "Africa") %>% 
  st_transform(crs = 'ESRI:54030') %>% 
  st_bbox() %>% 
  st_as_sfc() %>% 
  st_buffer(200000) 

# Import ocean shapes
oceans <- st_read("data/naturalearth/ne_110m_ocean.shp")

#Plot
africa_plot <- ggplot()+
  geom_sf(data = world_robinson, 
          colour = "lightgrey",
          fill = "transparent", 
          size = 0.5) +
  geom_sf(data = oceans, fill = "lightblue") +
  geom_sf(data = africa, mapping = aes(fill = quantiles)) +
  scale_fill_carto_d(type = quantitative, palette = "BurgYl") +
  guides(fill = guide_legend(label.position = "bottom")) +
  theme_void() +
  theme(legend.position = "bottom") +
  coord_sf(xlim = st_bbox(africa_bb)[c(1, 3)],
           ylim = st_bbox(africa_bb)[c(2, 4)]) +
  labs(
    title = "Total funds received per country for health aid in Africa",
    subtitle = "1991",
    caption = "Source: Eurostat",
    fill = ""
  )

Put everything together

# Put everything together

layout <- c(
  patchwork::area(t = 1, l = 2, b = 7, r = 10),
  patchwork::area(t = 1, l = 0, b = 6, r = 3)
)

plot_gg <- africa_plot + africa_inset_map +
  plot_layout(design = layout)

plot_gg


Question 7 Open ended question

For this question, the guidelines are to find different shapefiles and to be able to overlay them on a map. They suggest that we look at the SITG website to find the different files.

I decided to plot the things I liked. The goal is to look where are the natural reserves, the vineyards and the sports facilities in Geneva.

Here we go!

#Import files FROM SIGT
sports_facilities <- st_read("data/SHP_UNI_SPORTS_EQUIPEMENTS/UNI_SPORTS_EQUIPEMENTS.shp")
geneva_vineyard <- st_read("data/SHP_VIT_VIGNOBLE_FEDERAL/VIT_VIGNOBLE_FEDERAL.shp")
natural_reserve <- st_read("data/SHP_FFP_RES_NAT_PLAN_SITE/FFP_RES_NAT_PLAN_SITE.shp")

# Import Geneva shape
cantons <- st_read("data/Archive_3/G1K09.shp")
geneva <- cantons %>% 
  filter(KURZ == "GE")

#Transform data into the same projection
sports_facilities <- st_transform(sports_facilities, crs = 4326)
geneva_vineyard <- st_transform(geneva_vineyard, crs = 4326)
natural_reserve <- st_transform(natural_reserve, crs = 4326)
geneva <- st_transform(geneva, crs = 4326)

# Plot the map
ggplot() +
  geom_sf(data = geneva) +
  geom_sf(data = sports_facilities, size = 1, aes(color = "Sports Facilities")) +
  geom_sf(data = natural_reserve, aes(fill = "Natural Reserve")) +
  geom_sf(data = geneva_vineyard, aes(fill = "Vineyard")) +
  theme_void()  +
  scale_fill_manual(name = "areas", values = c("lightgreen","#631E2D")) +
  scale_color_manual(name = "buildings", values = "black") +
  labs(title = "Geneva's natural reserve, vineyard and sports facilities",
       caption = "Source: SITG") 

Question 8 OpenStreetMap

Finally, I will use OpenStreetMap’s free tagging system that allows the map to include an unlimited number of attributes describing each feature. We can therefore represent any physical features on the ground.

For this I will try to show where are the clinics and zoo of Havana in Cuba, but also the roads, rivers, lakes and bays.

# get the features from OpenStreetMap
roads <- getbb("Havana") %>% # get coordinates
  opq()  %>%        # transform into a list
  add_osm_feature(  # add features
    key = "highway",
    value = c(
      "motorway", "primary",
      "secondary", "tertiary"
    )
  ) %>% 
  osmdata_sf()  %>%    # transform to an sf object
  purrr::pluck("osm_lines")

river <- getbb("Havana") %>%
  opq() %>% 
  add_osm_feature(key = 'waterway', value = 'river') %>%
  osmdata_sf() %>%
  purrr::pluck('osm_lines')

lakes <- getbb("Havana") %>% 
  opq() %>% 
  add_osm_feature(key = "natural", value = "water") %>%
  osmdata_sf() %>%
  unname_osmdata_sf() %>%   
  purrr::pluck("osm_multipolygons")

bay <- getbb("Havana") %>% 
  opq() %>% 
  add_osm_feature(key = "natural", value = "bay") %>%
  osmdata_sf() %>%
  unname_osmdata_sf() %>%
  purrr::pluck("osm_multipolygons")

clinic <- getbb("Havana") %>% 
  opq() %>% 
  add_osm_feature(key = "amenity", value = "clinic") %>%
  osmdata_sf() %>%
  unname_osmdata_sf() %>% 
  purrr::pluck("osm_polygons")

zoo <- getbb("Havana") %>% 
  opq() %>% 
  add_osm_feature(key = "tourism", value = "zoo") %>%
  osmdata_sf() %>%
  unname_osmdata_sf() %>%
  purrr::pluck("osm_polygons")


# Plot the features  
ggplot() +
  geom_sf(data = roads, color = "black", size = 1) +
  geom_sf(data = river,  color = "#3182bd", size = 1) +
  geom_sf(data = lakes, fill = "#3182bd", color = "#3182bd" ) +
  geom_sf(data = bay, fill = "#3182bd", color = "#3182bd" ) +
  geom_sf(data = clinic, color = "red" , size = 3) +
  geom_sf(data = zoo, fill = "darkgreen") +
  theme_void() +
  labs(title = "Map of Havana",
       subtitle = "Showing emplacement of <span style='color:red'>**clinics**</span>  and <span style='color:darkgreen'>**zoo**</span>",
       caption = "Source: OpenStreetMap") +
  theme(plot.subtitle = ggtext::element_markdown())

 




A work by Valentin Monney